home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap09 / howto03 / delphi10 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-11  |  51.5 KB  |  1,524 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl,
  8.   {Winsock,} CCWSock, CCICCInf, CCICCPrf, IniFiles, Gauges;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : string; { Connection profile; used in lists }
  15.     CIPAddress : string; { Dotted character IP Address       }
  16.     CUserName  : string; { Login name to site; can be anonym }
  17.     CPassword  : string; { Password; won't be shown          }
  18.     CStartDir  : string; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   TCCINetCCForm = class(TForm)
  23.     Panel1: TPanel;
  24.     Panel2: TPanel;
  25.     Panel3: TPanel;
  26.     Panel4: TPanel;
  27.     Panel5: TPanel;
  28.     Panel6: TPanel;
  29.     ListBox1: TListBox;
  30.     Panel7: TPanel;
  31.     SpeedButton1: TSpeedButton;
  32.     SpeedButton2: TSpeedButton;
  33.     ListBox2: TListBox;
  34.     ComboBox1: TComboBox;
  35.     Button1: TButton;
  36.     Memo1: TMemo;
  37.     SpeedButton4: TSpeedButton;
  38.     SpeedButton5: TSpeedButton;
  39.     SpeedButton3: TSpeedButton;
  40.     Panel8: TPanel;
  41.     Label1: TLabel;
  42.     Label2: TLabel;
  43.     ComboBox2: TComboBox;
  44.     Label3: TLabel;
  45.     ComboBox3: TComboBox;
  46.     Label4: TLabel;
  47.     Label5: TLabel;
  48.     OpenDialog1: TOpenDialog;
  49.     SaveDialog1: TSaveDialog;
  50.     PrintDialog1: TPrintDialog;
  51.     PrinterSetupDialog1: TPrinterSetupDialog;
  52.     FindDialog1: TFindDialog;
  53.     ReplaceDialog1: TReplaceDialog;
  54.     Gauge1: TGauge;
  55.     MainMenu1: TMainMenu;
  56.     Network1: TMenuItem;
  57.     ViewWinsockInfo1: TMenuItem;
  58.     Description1: TMenuItem;
  59.     SystemStatus1: TMenuItem;
  60.     VendorSpecific1: TMenuItem;
  61.     N1: TMenuItem;
  62.     ProgressInfo1: TMenuItem;
  63.     ViewInEditWindow1: TMenuItem;
  64.     ViewInStatusLine1: TMenuItem;
  65.     SaveToFile1: TMenuItem;
  66.     N2: TMenuItem;
  67.     Exit1: TMenuItem;
  68.     Services1: TMenuItem;
  69.     IPAddress1: TMenuItem;
  70.     EMail1: TMenuItem;
  71.     FTP1: TMenuItem;
  72.     UsenetNws1: TMenuItem;
  73.     Files1: TMenuItem;
  74.     Load1: TMenuItem;
  75.     Save1: TMenuItem;
  76.     Encoding1: TMenuItem;
  77.     UUDecode1: TMenuItem;
  78.     MIMEDecode1: TMenuItem;
  79.     UUEncode1: TMenuItem;
  80.     MIMEEncode1: TMenuItem;
  81.     Edit1: TMenuItem;
  82.     Cut1: TMenuItem;
  83.     Copy1: TMenuItem;
  84.     CopytoFile1: TMenuItem;
  85.     Paste1: TMenuItem;
  86.     PastefromFile1: TMenuItem;
  87.     EMail2: TMenuItem;
  88.     CheckMail1: TMenuItem;
  89.     CreateNewMessage1: TMenuItem;
  90.     ReplyToCurrentMessage1: TMenuItem;
  91.     SendCurrentMessage1: TMenuItem;
  92.     SendQueue1: TMenuItem;
  93.     MailServers1: TMenuItem;
  94.     Mailboxes1: TMenuItem;
  95.     Correspondents1: TMenuItem;
  96.     TrashMarkedMessages1: TMenuItem;
  97.     EmptyTrash1: TMenuItem;
  98.     ExitEMailRequired1: TMenuItem;
  99.     FTP2: TMenuItem;
  100.     ConnectToSite1: TMenuItem;
  101.     Disconnect1: TMenuItem;
  102.     UploadMarked1: TMenuItem;
  103.     ASCII1: TMenuItem;
  104.     Binary1: TMenuItem;
  105.     DownloadMarked1: TMenuItem;
  106.     ASCII2: TMenuItem;
  107.     ToFile1: TMenuItem;
  108.     ToDisplay1: TMenuItem;
  109.     Binary2: TMenuItem;
  110.     Directory1: TMenuItem;
  111.     ViewRemoteasText1: TMenuItem;
  112.     ViewasText1: TMenuItem;
  113.     Change1: TMenuItem;
  114.     Create1: TMenuItem;
  115.     Delete3: TMenuItem;
  116.     ChangeLocal1: TMenuItem;
  117.     DeleteRemoteFiles1: TMenuItem;
  118.     FTPSites1: TMenuItem;
  119.     News1: TMenuItem;
  120.     ConnectandUpdate1: TMenuItem;
  121.     Disconnect2: TMenuItem;
  122.     Headers1: TMenuItem;
  123.     RetrieveMarked1: TMenuItem;
  124.     RetrieveAll1: TMenuItem;
  125.     CheckNewNews1: TMenuItem;
  126.     GetMarked1: TMenuItem;
  127.     Article1: TMenuItem;
  128.     NewArticle1: TMenuItem;
  129.     FollowupArticle1: TMenuItem;
  130.     PutinQueue1: TMenuItem;
  131.     Post1: TMenuItem;
  132.     CurrentArticle1: TMenuItem;
  133.     EntireQueue1: TMenuItem;
  134.     NewsServers1: TMenuItem;
  135.     SubscribedNewsgroups1: TMenuItem;
  136.     Trash1: TMenuItem;
  137.     AllReadArticles1: TMenuItem;
  138.     AllMarkedArticles1: TMenuItem;
  139.     AllAvailableArticles1: TMenuItem;
  140.     DownloadActiveNewsgroups1: TMenuItem;
  141.     Preferences1: TMenuItem;
  142.     EMail3: TMenuItem;
  143.     FTP3: TMenuItem;
  144.     News2: TMenuItem;
  145.     Paths1: TMenuItem;
  146.     procedure Exit1Click(Sender: TObject);
  147.     procedure FormCreate(Sender: TObject);
  148.     procedure FormDestroy(Sender: TObject);
  149.     procedure Description1Click(Sender: TObject);
  150.     procedure SystemStatus1Click(Sender: TObject);
  151.     procedure VendorSpecific1Click(Sender: TObject);
  152.     procedure ViewInEditWindow1Click(Sender: TObject);
  153.     procedure ViewInStatusLine1Click(Sender: TObject);
  154.     procedure SaveToFile1Click(Sender: TObject);
  155.     procedure IPAddress1Click(Sender: TObject);
  156.     procedure FTP1Click(Sender: TObject);
  157.     procedure FormResize(Sender: TObject);
  158.     procedure FTPSites1Click(Sender: TObject);
  159.     procedure FTP3Click(Sender: TObject);
  160.     procedure ConnectToSite1Click(Sender: TObject);
  161.     procedure Button1Click(Sender: TObject);
  162.     procedure Disconnect1Click(Sender: TObject);
  163.   private
  164.     { Private declarations }
  165.   public
  166.     { Public declarations }
  167.     procedure EnableFTPMenus;
  168.     procedure DisableFTPMenus;
  169.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  170.     procedure DoFTPDisconnect;
  171.     procedure ReadIniData;
  172.     procedure WriteIniData;
  173.     procedure LoadFTPSiteFile;
  174.     procedure SaveFTPSiteFile;
  175.     procedure SetupFTPSiteLists;
  176.     procedure AddNullTermTextToMemo( TheTextToAdd   : string;
  177.                                      TheMemoToAddTo : TMemo   );
  178.     function AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  179.     procedure SetHGCursors;
  180.     procedure SetNormalCursors;
  181.     procedure AddProgressText( WhatText : string );
  182.     procedure ShowProgressText( WhatText : string );
  183.     procedure ShowProgressErrorText( WhatText : string );
  184.     procedure SocketsErrorOccurred( Sender     : TObject;
  185.                                      ErrorCode  : Integer;
  186.                                      TheMessage : string   );
  187.   end;
  188.   { Component to hold FTP handling capabilities }
  189.   TFTPComponent = class( TWinControl )
  190.   public
  191.     FTPCommandInProgress ,
  192.     Connection_Established : Boolean;
  193.     Socket1 : TCCSocket;
  194.     Socket2 : TCCSocket;
  195.     constructor Create( AOwner : TComponent ); override;
  196.     destructor Destroy; override;
  197.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  198.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  199.     function GetRemoteWorkingDirectory( var RemoteDir : string ) : Boolean;
  200.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  201.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  202.               : Boolean;
  203.     function Disconnect : Boolean;
  204.     function DoCStyleFormat(       TheText      : string;
  205.                              const TheArguments : array of const ) : string;
  206.     procedure AddProgressText( WhatText : string );
  207.     procedure ShowProgressText( WhatText : string );
  208.     procedure ShowProgressErrorText( WhatText : string );
  209.     function GetFTPServerResponse( var ResponseString : string ) : Integer;
  210.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  211.                                      ErrorCode  : Integer;
  212.                                      TheMessage : string   );
  213.     function PerformFTPCommand(
  214.                     TheCommand   : string;
  215.               const TheArguments : array of const ) : Integer;
  216.   end;
  217. const
  218.   POV_MEMO                 = 1; { Progress to the Memo           }
  219.   POV_STAT                 = 2; { Progress to the status caption }
  220.   FTP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  221.   FTP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  222.   FTP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  223.   FTP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  224.   FTP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  225.  
  226. var
  227.   CCINetCCForm         : TCCINetCCForm;
  228.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  229.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  230.   ProgressList         : TStringList;    { Used to hold progress text info }
  231.   ProgressFileName     : string;         { Used to hold progress file name }
  232.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  233.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  234.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  235.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  236.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  237.   MailPath             : string;         { Used for path to Mail Files     }
  238.   NewsPath             : string;         { Used for path to News Files     }
  239.   WWWPath              : string;         { Used for path to WWW Files      }
  240.   FTPPath              : string;         { Used for path to FTP Files      }
  241.   CurrentPassWordString : string;        { Used to hold login id for anons }
  242.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  243.   CurrentRealPWString   : string;        { Used to hold a real password    }
  244.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  245.   TheLine ,
  246.   HolderLine ,
  247.   GlobalTextBuffer      : string;
  248.   TheAnonRedialVector ,
  249.   DefaultDownloadVector : Integer;
  250.   LeftoverText          : string;
  251.   LeftoversOnTable      : Boolean;
  252.   FileNameToXFer        : string;
  253.  
  254. implementation
  255.  
  256. {$R *.DFM}
  257.  
  258. { This is the FTP components PWD routine }
  259. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : string )
  260.           : Boolean;
  261. var TheReturnString : string;  { Internal string holder }
  262.     TheResult       : Integer; { Internal int holder    }
  263. begin
  264.   Result := true;
  265.   TheReturnString :=
  266.    DoCStyleFormat( 'PWD' ,
  267.     [ nil ] );
  268.   { Put result in progress and status line }
  269.   AddProgressText( TheReturnString );
  270.   ShowProgressText( TheReturnString );
  271.   { Send Password sequence }
  272.   TheResult := PerformFTPCommand( 'PWD',
  273.                                   [ nil ] );
  274.   if TheResult <> FTP_STATUS_PRELIMINARY then
  275.   begin
  276.     Result := false;
  277.     FTPCommandInProgress := false;
  278.     exit;
  279.   end;
  280.   repeat
  281.     TheResult := GetFTPServerResponse( TheReturnString );
  282.     { Put result in progress and status line }
  283.     AddProgressText( TheReturnString );
  284.     ShowProgressText( TheReturnString );
  285.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  286.   FTPCommandInProgress := false;
  287.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  288.   begin
  289.     { Do clever C formatting trick }
  290.     TheReturnString :=
  291.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  292.       [ nil ] );
  293.     { Put result in progress and status line }
  294.     AddProgressText( TheReturnString );
  295.     ShowProgressErrorText( TheReturnString );
  296.     { Signal error }
  297.     Result := False;
  298.     { leave }
  299.     exit;
  300.   end
  301.   else
  302.   begin
  303.     Result := true; { Signal no problem }
  304.     RemoteDir := TheReturnString; { Send back last string on faith }
  305.   end;
  306. end;
  307.  
  308. { This is the FTP component constructor; it creates 2 sockets }
  309. constructor TFTPComponent.Create( AOwner : TComponent );
  310. begin
  311.   { do inherited create }
  312.   inherited Create( AOwner );
  313.   { Create sockets, put in their parents, and error procs }
  314.   Socket1 := TCCSocket.Create( Self );
  315.   Socket1.Parent := Self;
  316.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  317.   Socket2 := TCCSocket.Create( Self );
  318.   Socket2.Parent := Self;
  319.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  320.   { Set up booleans }
  321.   Connection_Established := false;
  322.   FTPCommandInProgress := false;
  323. end;
  324.  
  325. { This is the FTP component destructor; it frees 2 sockets }
  326. destructor TFTPComponent.Destroy;
  327. begin
  328.   { Free the sockets }
  329.   Socket1.Free;
  330.   Socket2.Free;
  331.   { and call inherited }
  332.   inherited Destroy;
  333. end;
  334.  
  335. { This sends FTP progress text to the Inet form }
  336. procedure TFTPComponent.AddProgressText( WhatText : string );
  337. begin
  338.   CCInetCCForm.AddProgressText( WhatText );
  339. end;
  340.  
  341. { This sends FTP progress text to the Inet form }
  342. procedure TFTPComponent.ShowProgressText( WhatText : string );
  343. begin
  344.   CCInetCCForm.ShowProgressText( WhatText );
  345. end;
  346.  
  347. { This sends FTP progress text to the Inet form }
  348. procedure TFTPComponent.ShowProgressErrorText( WhatText : string );
  349. begin
  350.   CCInetCCForm.ShowProgressErrorText( WhatText );
  351. end;
  352.  
  353. { This is a core function! It performs an FTP command and if no timeout }
  354. { return a preliminary ok.                                              }
  355. function TFTPComponent.PerformFTPCommand(
  356.                  TheCommand        : string;
  357.            const TheArguments      : array of const ) : Integer;
  358. var TheBuffer : string; { Text buffer }
  359. begin
  360.   { If command in progress send back -1 error }
  361.   if FTPCommandInProgress then
  362.   begin
  363.     Result := -1;
  364.     exit;
  365.   end;
  366.   { Set status variable }
  367.   FTPCommandInProgress := True;
  368.   { Set global error code }
  369.   GlobalErrorCode := 0;
  370.   { Format output string }
  371.   TheBuffer := Format( TheCommand , TheArguments );
  372.   { Preset failure code }
  373.   Result := FTP_STATUS_FATAL_ERROR;
  374.   { If invalid socket or no connection abort }
  375.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  376.    exit;
  377.   { Send the buffer plus EOL chars }
  378.   Socket1.StringData := TheBuffer + #13#10;
  379.   { if abort due to timeout or other error exit }
  380.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  381.   { Otherwise return preliminary code }
  382.   Result := FTP_STATUS_PRELIMINARY;
  383. end;
  384.  
  385. { This function gets up to 255 chars of data plus a return code from FTP serv }
  386. function TFTPComponent.GetFTPServerResponse(
  387.           var ResponseString : string ) : Integer;
  388. var
  389.   { Buffer string for response line }
  390.   TheBuffer     : string;
  391.   { Pointer to the response string }
  392.   BufferPointer : array[0..255] of char absolute TheBuffer;
  393.   { Character to check for response code }
  394.   ResponseChar   : char;
  395.   { Pointers into returned string }
  396.   TheIndex ,
  397.   TheLength     : Integer;
  398.   { Control variable }
  399.   LeftoversInPan ,
  400.   Finished      : Boolean;
  401. begin
  402.   { Preset fatal error }
  403.   Result := FTP_STATUS_FATAL_ERROR;
  404.   { Start loop control }
  405.   LeftoversInPan := false;
  406.   Finished := false;
  407.   repeat
  408.     { Do a peek }
  409.     TheBuffer := Socket1.PeekData;
  410.     { If timeout or other error exit }
  411.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  412.     { Find end of line character }
  413.     TheIndex := Pos( #10 , TheBuffer );
  414.     if TheIndex = 0 then
  415.     begin
  416.       TheIndex := Pos( #13 , TheBuffer );
  417.       if TheIndex = 0 then
  418.       begin
  419.         TheIndex := Pos( #0 , TheBuffer );
  420.         if TheIndex = 0 then
  421.         begin
  422.           TheIndex := Length( TheBuffer );
  423.           LeftoversInPan := True;
  424.           LeftoverText := LeftoverText + TheBuffer;
  425.           LeftoversOnTable := false;
  426.         end;
  427.       end;
  428.     end;
  429.     { If an end of line then process the line }
  430.     if TheIndex > 0 then
  431.     begin
  432.       { Get length of string }
  433.       TheLength := TheIndex;
  434.       { Receive actual data }
  435.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  436.                              @BufferPointer[ 1 ] ,
  437.                              TheLength              );
  438.       { Abort if timeout or error }
  439.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  440.       { Put in the length byte }
  441.       BufferPointer[ 0 ] := Chr( TheLength );
  442.       if LeftOversOnTable then
  443.       begin
  444.         LeftOversOnTable := false;
  445.         ResponseString := LeftoverText + TheBuffer;
  446.         TheBuffer := ResponseString;
  447.         LeftoverText := '';
  448.       end;
  449.       if LeftoversInPan then
  450.       begin
  451.         LeftoversInPan := false;
  452.         LeftoversOnTable := true;
  453.       end;
  454.       { If not a continuation line }
  455.       if TheBuffer[ 4 ] <> '-' then
  456.       begin
  457.         { Get first number character }
  458.         ResponseChar := TheBuffer[ 1 ];
  459.         { Get the value of the number from 1 to 5 }
  460.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  461.         begin
  462.           Finished := true;
  463.           Result := Ord( ResponseChar ) - 48;
  464.         end;
  465.       end
  466.       else
  467.       begin
  468.         { otherwise return preliminary result }
  469.         Finished := true;
  470.         Result := FTP_STATUS_PRELIMINARY;
  471.       end;
  472.     end
  473.     else
  474.     begin
  475.     end;
  476.   until ( Finished and ( not LeftoversOnTable ));
  477.   { Return buffer as response string }
  478.   ResponseString := TheBuffer;
  479. end;
  480.  
  481. { Boilerplate error routine }
  482. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  483.                                                  ErrorCode  : Integer;
  484.                                                  TheMessage : string   );
  485. begin
  486.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  487. end;
  488.  
  489. { This is the FTP components initial connection routine }
  490. function TFTPComponent.EstablishConnection(
  491.           PCRPointer : PConnectionsRecord ) : Boolean;
  492. var TheReturnString : string;  { Internal string holder }
  493.     TheResult       : Integer; { Internal int holder    }
  494. begin
  495.   { Set default FTP Port value }
  496.   Socket1.PortName := '21';
  497.   { Get the ip address from the record }
  498.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  499.   { Set blocking mode }
  500.   Socket1.AsynchMode := False;
  501.   { Clear condition variables }
  502.   GlobalErrorCode := 0;
  503.   GlobalAbortedFlag := false;
  504.   { Actually attempt to connect }
  505.   Socket1.CCSockConnect;
  506.   { Check if connected }
  507.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  508.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  509.   begin { Didn't connect; signal error and abort }
  510.     { Do clever C formatting trick }
  511.     TheReturnString :=
  512.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  513.       [ PCRPointer^.CIPAddress ] );
  514.     { Put result in progress and status line }
  515.     AddProgressText( TheReturnString );
  516.     ShowProgressErrorText( TheReturnString );
  517.     { Signal error }
  518.     Result := False;
  519.     { leave }
  520.     exit;
  521.   end
  522.   else
  523.   begin
  524.     Connection_Established := true;
  525.     { Signal successful connection }
  526.     TheReturnString := DoCStyleFormat(
  527.       'Connected on Local port: %s with IP: %s',
  528.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  529.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  530.     { Put result in progress and status line }
  531.     CCINetCCForm.AddProgressText( TheReturnString );
  532.     CCINetCCForm.ShowProgressText( TheReturnString );
  533.     TheReturnString := DoCStyleFormat(
  534.      'Connected to Remote port: %s with IP: %s',
  535.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  536.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  537.     { Put result in progress and status line }
  538.     CCINetCCForm.AddProgressText( TheReturnString );
  539.     CCINetCCForm.ShowProgressText( TheReturnString );
  540.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  541.      [ Socket1.IPAddressName ]);
  542.     { Put result in progress and status line }
  543.     CCINetCCForm.AddProgressText( TheReturnString );
  544.     CCINetCCForm.ShowProgressText( TheReturnString );
  545.     repeat
  546.       TheResult := GetFTPServerResponse( TheReturnString );
  547.       { Put result in progress and status line }
  548.       AddProgressText( TheReturnString );
  549.       ShowProgressText( TheReturnString );
  550.     until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  551.     if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  552.     begin
  553.       { Do clever C formatting trick }
  554.       TheReturnString :=
  555.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  556.         [ PCRPointer^.CIPAddress ] );
  557.       { Put result in progress and status line }
  558.       AddProgressText( TheReturnString );
  559.       ShowProgressErrorText( TheReturnString );
  560.       { Signal error }
  561.       Result := False;
  562.       { leave }
  563.       exit;
  564.     end
  565.     else Result := true; { Signal no problem }
  566.   end;
  567. end;
  568.  
  569. { This is the FTP components USER login routine }
  570. function TFTPComponent.LoginUser(
  571.           PCRPointer : PConnectionsRecord ) : Boolean;
  572. var TheReturnString : string;  { Internal string holder }
  573.     TheResult       : Integer; { Internal int holder    }
  574. begin
  575.   TheReturnString :=
  576.    DoCStyleFormat( 'USER %s' ,
  577.     [ PCRPointer^.CUserName ] );
  578.   { Put result in progress and status line }
  579.   AddProgressText( TheReturnString );
  580.   ShowProgressText( TheReturnString );
  581.   { Begin login sequence with user name }
  582.   TheResult := PerformFTPCommand( 'USER %s',
  583.                                   [ PCRPointer^.CUserName ] );
  584.   if TheResult <> FTP_STATUS_PRELIMINARY then
  585.   begin
  586.     FTPCommandInProgress := false;
  587.     Result := false;
  588.     exit;
  589.   end;
  590.   repeat
  591.     TheResult := GetFTPServerResponse( TheReturnString );
  592.     { Put result in progress and status line }
  593.     AddProgressText( TheReturnString );
  594.     ShowProgressText( TheReturnString );
  595.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  596.   FTPCommandInProgress := false;
  597.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_CONTINUING )) then
  598.   begin
  599.     { Do clever C formatting trick }
  600.     TheReturnString :=
  601.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  602.       [ PCRPointer^.CIPAddress ] );
  603.     { Put result in progress and status line }
  604.     AddProgressText( TheReturnString );
  605.     ShowProgressErrorText( TheReturnString );
  606.     { Signal error }
  607.     Result := False;
  608.     { leave }
  609.     exit;
  610.   end
  611.   else Result := true; { Signal no problem }
  612. end;
  613.  
  614.  
  615. { This is the FTP components PASSWORD routine }
  616. function TFTPComponent.SendPassword(
  617.           PCRPointer : PConnectionsRecord ) : Boolean;
  618. var TheReturnString : string;  { Internal string holder }
  619.     TheResult       : Integer; { Internal int holder    }
  620. begin
  621.   TheReturnString := 'PASS XXXXXX' + #13#10;
  622.   { Put result in progress and status line }
  623.   AddProgressText( TheReturnString );
  624.   ShowProgressText( TheReturnString );
  625.   { Send Password sequence }
  626.   TheResult := PerformFTPCommand( 'PASS %s',
  627.                                   [ PCRPointer^.CPassword ] );
  628.   if TheResult <> FTP_STATUS_PRELIMINARY then
  629.   begin
  630.     Result := false;
  631.     FTPCommandInProgress := false;
  632.     exit;
  633.   end;
  634.   repeat
  635.     TheResult := GetFTPServerResponse( TheReturnString );
  636.     { Put result in progress and status line }
  637.     AddProgressText( TheReturnString );
  638.     ShowProgressText( TheReturnString );
  639.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  640.   FTPCommandInProgress := false;
  641.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  642.   begin
  643.     { Do clever C formatting trick }
  644.     TheReturnString :=
  645.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  646.       [ PCRPointer^.CIPAddress ] );
  647.     { Put result in progress and status line }
  648.     AddProgressText( TheReturnString );
  649.     ShowProgressErrorText( TheReturnString );
  650.     { Signal error }
  651.     Result := False;
  652.     { leave }
  653.     exit;
  654.   end
  655.   else Result := true; { Signal no problem }
  656. end;
  657.  
  658. { This is the FTP components CWD routine }
  659. function TFTPComponent.SetRemoteStartupDirectory(
  660.           PCRPointer : PConnectionsRecord ) : Boolean;
  661. var TheReturnString : string;  { Internal string holder }
  662.     TheResult       : Integer; { Internal int holder    }
  663. begin
  664.   Result := true;
  665.   if PCRPointer^.CStartDir <> '' then
  666.   begin
  667.     TheReturnString :=
  668.      DoCStyleFormat( 'CWD %s' ,
  669.       [ PCRPointer^.CStartDir ] );
  670.     { Put result in progress and status line }
  671.     AddProgressText( TheReturnString );
  672.     ShowProgressText( TheReturnString );
  673.     { Send Password sequence }
  674.     TheResult := PerformFTPCommand( 'CWD %s',
  675.                                     [ PCRPointer^.CStartDir ] );
  676.     if TheResult <> FTP_STATUS_PRELIMINARY then
  677.     begin
  678.       Result := false;
  679.       FTPCommandInProgress := false;
  680.       exit;
  681.     end;
  682.     repeat
  683.       TheResult := GetFTPServerResponse( TheReturnString );
  684.       { Put result in progress and status line }
  685.       AddProgressText( TheReturnString );
  686.       ShowProgressText( TheReturnString );
  687.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  688.    FTPCommandInProgress := false;
  689.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  690.     begin
  691.       { Do clever C formatting trick }
  692.       TheReturnString :=
  693.        DoCStyleFormat( 'CWD to %s Failed!' ,
  694.         [ PCRPointer^.CStartDir ] );
  695.       { Put result in progress and status line }
  696.       AddProgressText( TheReturnString );
  697.       ShowProgressErrorText( TheReturnString );
  698.       { Signal error }
  699.       Result := False;
  700.       { leave }
  701.       exit;
  702.     end
  703.     else Result := true; { Signal no problem }
  704.   end;
  705. end;
  706.  
  707. { This is the FTP components QUIT routine }
  708. function TFTPComponent.Disconnect : Boolean;
  709. var TheReturnString : string;  { Internal string holder }
  710.     TheResult       : Integer; { Internal int holder    }
  711. begin
  712.   TheReturnString :=
  713.    DoCStyleFormat( 'QUIT' ,
  714.     [ nil ] );
  715.   { Put result in progress and status line }
  716.   AddProgressText( TheReturnString );
  717.   ShowProgressText( TheReturnString );
  718.   { Begin login sequence with user name }
  719.   TheResult := PerformFTPCommand( 'QUIT',
  720.                                   [ nil ] );
  721.   repeat
  722.     TheResult := GetFTPServerResponse( TheReturnString );
  723.     { Put result in progress and status line }
  724.     AddProgressText( TheReturnString );
  725.     ShowProgressText( TheReturnString );
  726.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  727.   FTPCommandInProgress := false;
  728.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  729.   begin
  730.     { Do clever C formatting trick }
  731.     TheReturnString :=
  732.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  733.       [ nil ] );
  734.     { Put result in progress and status line }
  735.     AddProgressText( TheReturnString );
  736.     ShowProgressErrorText( TheReturnString );
  737.     { Signal error }
  738.     Result := False;
  739.     { leave }
  740.     exit;
  741.   end
  742.   else Result := true; { Signal no problem }
  743. end;
  744.  
  745. function TFTPComponent.DoCStyleFormat(
  746.                 TheText      : string;
  747.           const TheArguments : array of const ) : string;
  748. begin
  749.   Result := Format( TheText , TheArguments ) + #13#10;
  750. end;
  751.  
  752.  
  753. { This procedure actually attempts to connect to the internet at an ftp site }
  754. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  755. var TheReturnString : string; { Display results of connection in status lines }
  756.     TheResult       : Integer;{ Result from FTP server                        }
  757.     FTPLoggedIn     : Boolean;{ Boolean to signal successful login            }
  758. begin
  759.   { Create the component }
  760.   Result := false;
  761.   { Do busy cursors }
  762.   SetHGCursors;
  763.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  764.   begin
  765.     { Do saved cursors }
  766.     TheFTPComponent.FTPCommandInProgress := false;
  767.     TheFTPComponent.Connection_Established := false;
  768.     SetNormalCursors;
  769.     exit;
  770.   end
  771.   else
  772.   begin { Connected; continue login process }
  773.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  774.     begin
  775.       { Do saved cursors }
  776.       TheFTPComponent.FTPCommandInProgress := false;
  777.       TheFTPComponent.Connection_Established := false;
  778.       SetNormalCursors;
  779.       exit;
  780.     end;
  781.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  782.     begin
  783.       { Do saved cursors }
  784.       TheFTPComponent.FTPCommandInProgress := false;
  785.       TheFTPComponent.Connection_Established := false;
  786.       SetNormalCursors;
  787.       exit;
  788.     end;
  789.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  790.     begin
  791.       { Do saved cursors }
  792.       SetNormalCursors;
  793.       TheFTPComponent.Connection_Established := false;
  794.       TheFTPComponent.FTPCommandInProgress := false;
  795.       exit;
  796.     end;
  797.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  798.     begin
  799.       { Do saved cursors }
  800.       TheFTPComponent.Connection_Established := false;
  801.       TheFTPComponent.FTPCommandInProgress := false;
  802.       SetNormalCursors;
  803.       exit;
  804.     end;
  805.     SetNormalCursors;
  806.     Result := true;
  807.     EnableFTPMenus;
  808.     TheFTPComponent.FTPCommandInProgress := false;
  809.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  810.   end;
  811. end;
  812.  
  813. { This procedure actually attempts to disconnect to the internet at an ftp site}
  814. procedure TCCINetCCForm.DoFTPDisconnect;
  815. begin
  816.   { Call QUIT command }
  817.   TheFTPComponent.Disconnect;
  818.   { Kill the socket }
  819.   TheFTPComponent.Socket1.CCSockClose;
  820. end;
  821.  
  822. { This procedure reads in the ini file and default path info }
  823. procedure TCCINetCCForm.ReadIniData;
  824. begin
  825.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  826.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  827.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  828.   WWWPath := TheICCIniFile.ReadString( 'Paths','WWWPath','C:\WINDOWS' );
  829.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  830.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  831.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  832.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  833.   TheICCIniFile.Free;
  834. end;
  835.  
  836. { This procedure writes out default path data to the ini file }
  837. procedure TCCINetCCForm.WriteIniData;
  838. begin
  839.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  840.   TheICCIniFile.WriteString( 'Paths','MailPath',MailPath );
  841.   TheICCIniFile.WriteString( 'Paths','NewsPath',NewsPath );
  842.   TheICCIniFile.WriteString( 'Paths','WWWPath',WWWPath );
  843.   TheICCIniFile.WriteString( 'Paths','FTPPath',FTPPath );
  844.   TheICCIniFile.WriteInteger( 'Vectors','PWControl',PasswordControlVector );
  845.   TheICCIniFile.WriteInteger( 'Vectors','DefDL',DefaultDownloadVector );
  846.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  847.   TheICCIniFile.Free;
  848. end;
  849.  
  850. { Procedure to load the FTP Site list }
  851. procedure TCCINetCCForm.LoadFTPSiteFile;
  852. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  853.     FTPSLName   : string;             { FTP Site List filename }
  854.     Counter_1   : Integer;            { Loop counter           }
  855. begin
  856.   { Create the sites list list }
  857.   TheFTPSiteList := TList.Create;
  858.   { Set up the FTP sites list file name }
  859.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  860.   { If the FTP Site List exists load it in }
  861.   if FileExists( FTPSLName ) then
  862.   begin
  863.     { set up the file and open it }
  864.     AssignFile( TheFTPSiteFile , FTPSLName );
  865.     Reset( TheFTPSiteFile );
  866.     { read in the records }
  867.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  868.     begin
  869.       { Create the TCRecord }
  870.       New( TheTCRecord );
  871.       { Read in the data record }
  872.       Seek( TheFTPSiteFile , Counter_1 );
  873.       Read( TheFTPSiteFile , TheTCRecord^ );
  874.       { Add the record to the list }
  875.       TheFTPSiteList.Add( TheTCRecord );
  876.     end;
  877.     { close the file }
  878.     CloseFile( TheFTPSiteFile );
  879.   end
  880.   else
  881.   { Otherwise create a default one with a few anonymous sites }
  882.   begin
  883.     { create new record }
  884.     New( TheTCRecord );
  885.     { fill in its info }
  886.     with TheTCRecord^ do
  887.     begin
  888.       CProfile   := 'Winsite Windows Archive';
  889.       CIPAddress := 'ftp.winsite.com';
  890.       CUserName  := 'anonymous';
  891.       CPassword  := 'guest@nowhere.com';
  892.       CStartDir  := '';
  893.     end;
  894.     { add it to the list }
  895.     { do it three more times }
  896.     TheFTPSiteList.Add( TheTCRecord );
  897.     New( TheTCRecord );
  898.     with TheTCRecord^ do
  899.     begin
  900.       CProfile   := 'Digital Equipment Corp';
  901.       CIPAddress := 'gatekeeper.dec.com';
  902.       CUserName  := 'anonymous';
  903.       CPassword  := 'guest@nowhere.com';
  904.       CStartDir  := '';
  905.     end;
  906.     TheFTPSiteList.Add( TheTCRecord );
  907.     New( TheTCRecord );
  908.     with TheTCRecord^ do
  909.     begin
  910.       CProfile   := 'Microsoft FTP Site';
  911.       CIPAddress := 'ftp.microsoft.com';
  912.       CUserName  := 'anonymous';
  913.       CPassword  := 'guest@nowhere.com';
  914.       CStartDir  := '';
  915.     end;
  916.     TheFTPSiteList.Add( TheTCRecord );
  917.     New( TheTCRecord );
  918.     with TheTCRecord^ do
  919.     begin
  920.       CProfile   := 'Oakland MSDOS Archive';
  921.       CIPAddress := 'oak.oakland.edu';
  922.       CUserName  := 'anonymous';
  923.       CPassword  := 'guest@nowhere.com';
  924.       CStartDir  := '';
  925.     end;
  926.     TheFTPSiteList.Add( TheTCRecord );
  927.     { create the file and write out the data, then close it }
  928.     AssignFile( TheFTPSiteFile , FTPSLName );
  929.     Rewrite( TheFTPSiteFile );
  930.     for Counter_1 := 0 to 3 do
  931.     begin
  932.       TheTCRecord :=
  933.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  934.       Seek( TheFTPSiteFile , Counter_1 );
  935.       Write( TheFTPSiteFile , TheTCRecord^ );
  936.     end;
  937.     CloseFile( TheFTPSiteFile );
  938.   end;
  939. end;
  940.  
  941. { This procedure saves off the FTP Site List }
  942. procedure TCCINetCCForm.SaveFTPSiteFile;
  943. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  944.     FTPSLName   : string;             { FTP Site List filename }
  945.     Counter_1   : Integer;            { Loop counter           }
  946. begin
  947.   { Set up the file name }
  948.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  949.   { Assign the file }
  950.   AssignFile( TheFTPSiteFile , FTPSLName );
  951.   { Rewrite it }
  952.   Rewrite( TheFTPSiteFile );
  953.   { run the list through the procedure }
  954.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  955.   begin
  956.     { get the record from the list }
  957.     TheTCRecord :=
  958.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  959.     { Do the seek/write }
  960.     Seek( TheFTPSiteFile , Counter_1 );
  961.     Write( TheFTPSiteFile , TheTCRecord^ );
  962.     { free the record }
  963.     Dispose( TheTCRecord );
  964.   end;
  965.   { Close the file }
  966.   CloseFile( TheFTPSiteFile );
  967.   { Free the list pointers }
  968.   TheFTPSiteList.Free;
  969.   TheWorkingFTPSL.Free;
  970. end;
  971.  
  972. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  973. procedure TCCINetCCForm.SetupFTPSiteLists;
  974. var ThePointer : PConnectionsRecord; { Generic PCR Pointer }
  975.     Counter_1  : Integer;            { Loop counter        } 
  976. begin
  977.   { Set up display for main form }
  978.   CCINetCCForm.Tag := 2;
  979.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  980.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  981.   CCINetCCForm.FTP1.Enabled := false;
  982.   CCINetCCForm.FTP2.Enabled := true;
  983.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  984.   CCINetCCForm.Button1.Caption := 'Connect';
  985.   CCINetCCForm.Label4.Caption := 'Local Dir';
  986.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  987.   { Set tag for FTP stuff }
  988.   CCICInfoDlg.Tag := 2;
  989.   { set up caption of main label }
  990.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  991.   { hide outline panel }
  992.   CCICInfoDlg.Panel6.Visible := false;
  993.   { clear the list box }
  994.   CCICInfoDlg.ListBox2.Clear;
  995.   CCINetCCForm.ComboBox1.Clear;
  996.   { add profile strings to the list box }
  997.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  998.   begin
  999.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  1000.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1001.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  1002.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1003.   end;
  1004.   { Set up caption of special button }
  1005.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  1006.   { Start with top record }
  1007.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  1008.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  1009.   { put in data from top record and reset captions }
  1010.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  1011.   begin
  1012.     with CCICInfoDlg do
  1013.     begin
  1014.       Edit1.Text := CProfile;
  1015.       Panel2.Caption := '            Name:';
  1016.       Edit2.Text := CIPAddress;
  1017.       Panel3.Caption := '     IP Address:';
  1018.       Edit3.Text := CUserName;
  1019.       Panel5.Caption := '    User Name:';
  1020.       case PasswordControlVector of
  1021.         1 : Edit4.Text := CPassword;
  1022.         2 : Edit4.Text := '**********';
  1023.       end;
  1024.       Panel8.Caption := '      Password:';
  1025.       Edit5.Text := CStartDir;
  1026.       Panel9.Caption := '    Starting Dir:';
  1027.     end;
  1028.   end;
  1029.   { Create the working copy for use to make safe changes in info dlg }
  1030.   TheWorkingFTPSL := TList.Create;
  1031.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1032.   begin
  1033.     New( ThePointer );
  1034.     ThePointer^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  1035.     TheWorkingFTPSL.Add( ThePointer );
  1036.   end;
  1037. end;
  1038.  
  1039. { This procedure scans a line of UNIX-style text for #10's and }
  1040. { outputs them as lines to the memo. It stops at #0.           }
  1041. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : string;
  1042.                                  TheMemoToAddTo : TMemo   );
  1043. var
  1044.   TextLength ,            { Total chars to output         }
  1045.   Counter_1    : Integer; { Loop Index                    }
  1046. begin
  1047.   { Make the target memo visible just in case }
  1048.   TheMemoToAddTo.Visible := true;
  1049.   { Find total chars to output }
  1050.   TextLength := Length( TheTextToAdd );
  1051.   { If none then leave }
  1052.   if TextLength = 0 then exit;
  1053.   { Loop along the string }
  1054.   for Counter_1 := 1 to TextLength do
  1055.   begin
  1056.     { If hit ASCII 10 then assume end of line and output }
  1057.     if TheTextToAdd[ Counter_1 ] = #10 then
  1058.     begin
  1059.       { Use a try loop incase memo fills up }
  1060.       try
  1061.         { Add the line }
  1062.         TheMemoToAddTo.Lines.Add( TheLine );
  1063.       except
  1064.         { If memo fills up }
  1065.         on EOutOfResources do
  1066.         begin
  1067.           { Clear the old data }
  1068.           TheMemoToAddTo.Clear;
  1069.           { Output the new }
  1070.           TheMemoToAddTo.Lines.Add( TheLine );
  1071.         end;
  1072.       end;
  1073.       { clear the output buffer }
  1074.       TheLine := '';
  1075.     end
  1076.     else
  1077.     { Otherwise look for null terminator from Winsock }
  1078.     begin
  1079.       { If don't hit null terminator then add the char to op buffer }
  1080.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1081.       begin
  1082.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1083.       end
  1084.       else
  1085.       begin
  1086.         if TheLine <> '' then
  1087.         begin
  1088.           { Use a try loop incase memo fills up }
  1089.           try
  1090.             { Add the line }
  1091.             TheMemoToAddTo.Lines.Add( TheLine );
  1092.           except
  1093.             { If memo fills up }
  1094.             on EOutOfResources do
  1095.             begin
  1096.               { Clear the old data }
  1097.               TheMemoToAddTo.Clear;
  1098.               { Output the new }
  1099.               TheMemoToAddTo.Lines.Add( TheLine );
  1100.             end;
  1101.           end;
  1102.           { clear the output buffer }
  1103.           TheLine := '';
  1104.         end;
  1105.       end;
  1106.     end;
  1107.   end;
  1108. end;
  1109.  
  1110. { This function scans a line of UNIX-style text for #10's and }
  1111. { outputs the first line as its return value,stopping at #0.  }
  1112. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  1113. var
  1114.   TheLine      : string;  { Buffer to output current line }
  1115.   TextLength ,            { Total chars to output         }
  1116.   Counter_1    : Integer; { Loop Index                    }
  1117. begin
  1118.   { Clear output buffer }
  1119.   TheLine := '';
  1120.   { Find total chars to output }
  1121.   TextLength := Length( TheTextToAdd );
  1122.   { If none then leave }
  1123.   if TextLength = 0 then
  1124.   begin
  1125.     { Return nothing }
  1126.     Result := '';
  1127.     { Leave }
  1128.     exit;
  1129.   end;
  1130.   { Loop along the string }
  1131.   for Counter_1 := 1 to TextLength do
  1132.   begin
  1133.     { If hit ASCII 10 then assume end of line and output }
  1134.     if TheTextToAdd[ Counter_1 ] = #10 then
  1135.     begin
  1136.       { Return first line }
  1137.       Result := TheLine;
  1138.       { Leave }
  1139.       exit;
  1140.     end
  1141.     else
  1142.     { Otherwise look for null terminator from Winsock }
  1143.     begin
  1144.       { If don't hit null terminator then add the char to op buffer }
  1145.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1146.       begin
  1147.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1148.       end
  1149.       else break; { Otherwise drop out of the loop }
  1150.     end;
  1151.   end;
  1152.   { If hit #0 before #10 return buffer }
  1153.   Result := TheLine;
  1154. end;
  1155.  
  1156. { Show busy cursors }
  1157. procedure TCCINetCCForm.SetHGCursors;
  1158. begin
  1159.   CCInetCCForm.Cursor := crHourGlass;
  1160.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  1161. end;
  1162.  
  1163. { Show normal cursors }
  1164. procedure TCCINetCCForm.SetNormalCursors;
  1165. begin
  1166.   CCInetCCForm.Cursor := crDefault;
  1167.   CCInetCCForm.Memo1.Cursor := crDefault;
  1168. end;
  1169.  
  1170. { Exit method }
  1171. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  1172. begin
  1173.   Close;
  1174. end;
  1175.  
  1176. { This method adds a line to the progress text stringlist  }
  1177. { If an exception occurs, the list is full, and it is auto }
  1178. { saved to the progress text file name, then cleared.      }
  1179. procedure TCCINetCCForm.AddProgressText( WhatText : string );
  1180. begin
  1181.   { Use a try..except loop to catch list overflows }
  1182.   try
  1183.     { Try the normal add }
  1184.     ProgressList.Add( WhatText );
  1185.   except
  1186.     { Any list error is assumed to be a list overflow }
  1187.     on EListError do
  1188.     begin
  1189.       { Save the list to the preset file name }
  1190.       ProgressList.SaveToFile( ProgressFileName );
  1191.       { Clear the list to make more room }
  1192.       ProgressList.Clear;
  1193.       { And redo the add; any further errors will except normally }
  1194.       ProgressList.Add( WhatText );
  1195.     end;
  1196.     { This might happen too! }
  1197.     on EOutOfResources do
  1198.     begin
  1199.       { Save the list to the preset file name }
  1200.       ProgressList.SaveToFile( ProgressFileName );
  1201.       { Clear the list to make more room }
  1202.       ProgressList.Clear;
  1203.       { And redo the add; any further errors will except normally }
  1204.       ProgressList.Add( WhatText );
  1205.     end;
  1206.   end;
  1207. end;
  1208.  
  1209. { This method either adds the progress line to the current memo }
  1210. { or puts it in the status caption at normal colors.            }
  1211. procedure TCCINetCCForm.ShowProgressText( WhatText : string );
  1212. begin
  1213.   { Use the POV to determine where to show progress info }
  1214.   case ProgressOutputVector of
  1215.     POV_MEMO : begin { Output into the memo  }
  1216.                  AddNullTermTextToMemo( WhatText , Memo1 );
  1217.                end;
  1218.     POV_STAT : begin { Output on status line }
  1219.                  { Set panel caption font to black }
  1220.                  Panel1.Font.Color := clBlack;
  1221.                  { Get the first line of text and put in caption }
  1222.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  1223.                end;
  1224.   end;
  1225. end;
  1226.  
  1227. { This method is identical with SPT except sets status color to red and beeps }
  1228. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : string );
  1229. begin
  1230.   { Do error beep }
  1231.   MessageBeep( mb_IconExclamation );
  1232.   { Use the POV to determine where to show progress info }
  1233.   case ProgressOutputVector of
  1234.     POV_MEMO : begin { Output into the memo  }
  1235.                  AddNullTermTextToMemo( WhatText , Memo1 );
  1236.                end;
  1237.     POV_STAT : begin { Output on status line }
  1238.                  { Set panel caption font to black }
  1239.                  Panel1.Font.Color := clRed;
  1240.                  { Get the first line of text and put in caption }
  1241.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  1242.                end;
  1243.   end;
  1244. end;
  1245.  
  1246. { This is the boilerplate method used to handle Socket errors gracefully }
  1247. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  1248.                                               ErrorCode  : Integer;
  1249.                                               TheMessage : string   );
  1250. begin
  1251.   { Set the global error code flag }
  1252.   GlobalErrorCode := ErrorCode;
  1253.   { If a timeout error }
  1254.   if ErrorCode = WSAETIMEDOUT then
  1255.   begin
  1256.     { Set the aborted flag }
  1257.     GlobalAbortedFlag := True;
  1258.     { But clear the error code for graceful handling }
  1259.     GlobalErrorCode := 0;
  1260.   end
  1261.   else
  1262.   begin
  1263.     { Otherwise set the progress buffer to the error message }
  1264.     AddProgressText( TheMessage );
  1265.     { And show the progress text as set by option }
  1266.     ShowProgressErrorText( TheMessage );
  1267.   end;
  1268. end;
  1269.  
  1270. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  1271. begin
  1272.   { Create the progress string list }
  1273.   ProgressList := TStringList.Create;
  1274.   { Create the file name for saving the progress list }
  1275.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  1276.   { Default progress output to status line }
  1277.   ProgressOutputVector := POV_STAT;
  1278.   { Set password control stuff }
  1279.   PasswordControlVector := 2;
  1280.   CurrentPasswordString := 'guest@nowhere.com';
  1281.   CurrentRealPWString := 'guest@nowhere.com';
  1282.   { Get Ini file Data }
  1283.   ReadIniData;
  1284.   LoadFTPSiteFile;
  1285. end;
  1286.  
  1287. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  1288. begin
  1289.   { Free the progress text stringlist if assigned }
  1290.   if assigned( ProgressList ) then ProgressList.Free;
  1291.   { Save off the Ini data }
  1292.   WriteIniData;
  1293.   { Save and remove FTP site list stuff }
  1294.   SaveFTPSiteFile;
  1295.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  1296. end;
  1297.  
  1298. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  1299. var
  1300.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1301.   TheData    : string;    { Holder for data                           }
  1302. begin
  1303.   { Create socket; auto calls WSAStartup }
  1304.   TempSocket := TCCSocket.Create( Self );
  1305.   { Do parent just for kicks; no longer needed }
  1306.   TempSocket.Parent := self;
  1307.   { Put in error handler }
  1308.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1309.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  1310.   { Display the Description string }
  1311.   AddProgressText( TheData + #0 );
  1312.   { And show the progress text as set by option }
  1313.   ShowProgressText( TheData + #0 );
  1314.   { Free the socket; auto calls WSACleanup }
  1315.   TempSocket.Free;
  1316. end;
  1317.  
  1318. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  1319. var
  1320.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1321.   TheData    : string;    { Holder for data                           }
  1322. begin
  1323.   { Create socket; auto calls WSAStartup }
  1324.   TempSocket := TCCSocket.Create( Self );
  1325.   { Do parent just for kicks; no longer needed }
  1326.   TempSocket.Parent := self;
  1327.   { Put in error handler }
  1328.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1329.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  1330.   { Display the Description string }
  1331.   AddProgressText( TheData + #0 );
  1332.   { And show the progress text as set by option }
  1333.   ShowProgressText( TheData + #0 );
  1334.   { Free the socket; auto calls WSACleanup }
  1335.   TempSocket.Free;
  1336. end;
  1337.  
  1338. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  1339. var
  1340.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1341.   TheData    : string;    { Holder for data                           }
  1342. begin
  1343.   { Create socket; auto calls WSAStartup }
  1344.   TempSocket := TCCSocket.Create( Self );
  1345.   { Do parent just for kicks; no longer needed }
  1346.   TempSocket.Parent := self;
  1347.   { Put in error handler }
  1348.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1349.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  1350.   { Display the Description string }
  1351.   AddProgressText( TheData + #0 );
  1352.   { And show the progress text as set by option }
  1353.   ShowProgressText( TheData + #0 );
  1354.   { Free the socket; auto calls WSACleanup }
  1355.   TempSocket.Free;
  1356. end;
  1357.  
  1358. { This method sets the progress output vector to the memo }
  1359. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  1360. begin
  1361.   { Set the vector }
  1362.   ProgressOutputVector := POV_MEMO;
  1363.   { Keep the menu options consistent }
  1364.   ViewInEditWindow1.Checked := true;
  1365.   ViewInStatusLine1.Checked := false;
  1366. end;
  1367.  
  1368. { This method sets the progress output vector to the status line }
  1369. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  1370. begin
  1371.   { Set the vector }
  1372.   ProgressOutputVector := POV_STAT;
  1373.   { Keep the menus consistent }
  1374.   ViewInEditWindow1.Checked := false;
  1375.   ViewInStatusLine1.Checked := true;
  1376. end;
  1377.  
  1378. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  1379. begin
  1380.   { Set up the dialog parameters }
  1381.   OpenDialog1.Filename := ProgressFileName;
  1382.   OpenDialog1.Title := 'Select Filename for Progress File';
  1383.   OpenDialog1.Filter := 'Text Files|*.txt';
  1384.   { If the dialog is not cancelled then save and clear }
  1385.   if OpenDialog1.Execute then
  1386.   begin
  1387.     ProgressFileName := OpenDialog1.FileName;
  1388.     ProgressList.SaveToFile( ProgressFileName );
  1389.     ProgressList.Clear;
  1390.   end;
  1391. end;
  1392.  
  1393. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  1394. begin
  1395.   { Set up info dialog for IP Address getting }
  1396.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  1397.   CCICInfoDlg.Panel4.Visible := false;
  1398.   CCICInfoDlg.Panel6.Visible := false;
  1399.   CCICInfoDlg.Panel9.Visible := false;
  1400.   CCICInfoDlg.Panel8.Visible := false;
  1401.   CCICInfoDlg.BitBtn2.Visible := false;
  1402.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  1403.   CCICInfoDlg.Button2.Visible := false;
  1404.   CCICInfoDlg.Button3.Visible := false;
  1405.   CCICInfoDlg.Button4.Visible := false;
  1406.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  1407.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  1408.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  1409.   CCICInfoDlg.Edit1.Text := '';
  1410.   CCICInfoDlg.Edit2.Text := '';
  1411.   CCICInfoDlg.Edit3.Text := '';
  1412.   { Set IP Address Mode }
  1413.   CCICInfoDlg.Tag := 1;
  1414.   { Show Modally to get the information }
  1415.   CCICInfoDlg.ShowModal;
  1416.   { Reset the info dialog to default conditions }
  1417.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  1418.   CCICInfoDlg.Panel4.Visible := true;
  1419.   CCICInfoDlg.Panel6.Visible := true;
  1420.   CCICInfoDlg.Panel9.Visible := true;
  1421.   CCICInfoDlg.Panel8.Visible := true;
  1422.   CCICInfoDlg.BitBtn2.Visible := true;
  1423.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  1424.   CCICInfoDlg.Button2.Visible := true;
  1425.   CCICInfoDlg.Button3.Visible := true;
  1426.   CCICInfoDlg.Button4.Visible := true;
  1427.   CCICInfoDlg.Panel2.Caption := '             Name:';
  1428.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  1429.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  1430.   CCICInfoDlg.Edit1.Text := '';
  1431.   CCICInfoDlg.Edit2.Text := '';
  1432.   CCICInfoDlg.Edit3.Text := '';
  1433. end;
  1434.  
  1435. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  1436. begin
  1437.   { Set up the FTP Data displays }
  1438.   SetupFTPSiteLists;
  1439.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  1440.   TheFTPComponent.Parent := CCInetCCForm;
  1441. end;
  1442.  
  1443. procedure TCCINetCCForm.FormResize(Sender: TObject);
  1444. begin
  1445.   { Use tag vector to determine what to do }
  1446.   case Tag of
  1447.     { if FTP , make sure two list boxes are same height }
  1448.     2 : Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  1449.   end;
  1450. end;
  1451.  
  1452. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  1453. begin
  1454.   { Show Modally to get the information }
  1455.   CCICInfoDlg.ShowModal;
  1456. end;
  1457.  
  1458. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  1459. begin
  1460.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  1461.   CCICPrefsDlg.Tag := 2;
  1462.   CCICPrefsDlg.ShowModal;
  1463. end;
  1464.  
  1465. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  1466. var Counter_1 : Integer;
  1467. begin
  1468.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  1469.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  1470.   begin
  1471.     for Counter_1 := 1 to TheAnonRedialVector do
  1472.     begin
  1473.       DoFTPConnection( PConnectionsRecord(
  1474.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  1475.       if TheFTPComponent.Connection_Established then exit;
  1476.     end;
  1477.   end
  1478.   else DoFTPConnection( PConnectionsRecord(
  1479.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  1480. end;
  1481.  
  1482. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  1483. begin
  1484.   case Tag of
  1485.     2 : begin
  1486.           if not TheFTPComponent.Connection_Established then
  1487.            ConnectToSite1Click( Self ) else
  1488.            begin
  1489.              DoFTPDisconnect;
  1490.              TheFTPComponent.Connection_Established := false;
  1491.              DisableFTPMenus;
  1492.            end;
  1493.         end;
  1494.   end;
  1495. end;
  1496.  
  1497. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  1498. begin
  1499.   DoFTPDisconnect;
  1500.   DisableFTPMenus;
  1501. end;
  1502.  
  1503. procedure TCCINetCCForm.EnableFTPMenus;
  1504. begin
  1505.   Button1.Caption := 'Disconnect';
  1506.   ConnectToSite1.Enabled := false;
  1507.   Disconnect1.Enabled := true;
  1508.   Directory1.Enabled := true;
  1509.   UploadMarked1.Enabled := true;
  1510.   DownloadMarked1.Enabled := true;
  1511. end;
  1512.  
  1513. procedure TCCINetCCForm.DisableFTPMenus;
  1514. begin
  1515.   Button1.Caption := 'Connect';
  1516.   ConnectToSite1.Enabled := true;
  1517.   Disconnect1.Enabled := false;
  1518.   Directory1.Enabled := false;
  1519.   UploadMarked1.Enabled := false;
  1520.   DownloadMarked1.Enabled := false;
  1521. end;
  1522.  
  1523. end.
  1524.